home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / sdimage.com / SDIMAGE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-14  |  43.6 KB  |  1,084 lines
  1.  
  2. { *********************************************************************** }
  3. {                            SDImage  V1.03                               }
  4. {                        as of 14 February 1989                           }
  5. {                                                                         }
  6. {    SDImage V1.03 is a graphics image save/display utility which allows  }
  7. {  you to save graphic images to memory or disk and redisplay them.       }
  8. {  Image files can be read in another program or at a later date by       }
  9. {  referring to the file by it's reference number in DisplayImage.        }
  10. {    This unit is only dependant upon the BGI Graph unit. All activity is }
  11. {  performed through the BGI, so anything that BGI supports SDImage also  }
  12. {  supports automatically. Image size is not a factor. SDImage            }
  13. {  automatically handles images that are larger than 64K. In fact, it     }
  14. {  can handle any size image without requiring massive heap storage.      }
  15. {    If the image size exceeds the buffer size, it will be automatically  }
  16. {  stored to a disk file. Thus a full VGA screen could be saved with      }
  17. {  a buffer size of only 1K. Note: It will take longer to save/display    }
  18. {  the image with smaller buffers since the image has to be stored and    }
  19. {  retrieved to disk.                                                     }
  20. {                                                                         }
  21. {    The mechanism that SDImage uses to save an image to disk is one      }
  22. {  file per image. Thus if you intend to save lots of images, I strongly  }
  23. {  recommend that you place them in a seperate subdirectory to help keep  }
  24. {  things uncluttered. Also be aware that SDImage will leave image files  }
  25. {  laying around if you don't remove them yourself. Which is another      }
  26. {  good reason for putting the image files in their own directory so      }
  27. {  that you can quickly find them and delete them if this is a problem.   }
  28. {                                                                         }
  29. {    It should be further noted that to operate correctly, the image      }
  30. {  buffer size that is used to read in an image must be the same size     }
  31. {  (or larger) than the image buffer that was used to save the image.     }
  32. {  Because of this, if the image buffer size is too small, SDImage will   }
  33. {  automatically resize the image read buffer to the correct size.        }
  34. {                                                                         }
  35. {  Version 1.03 adds the ability to do RLE (Run Length Encoding) on the   }
  36. {  image file to reduce the size of the image file saved to disk.         }
  37. {  Additionally version 1.03 corrects an obscure bug in 1.02 which caused }
  38. {  images to occasionally be partially damaged in the Expand/Merge        }
  39. {  special effects modes.                                                 }
  40. {                                                                         }
  41. {         Originally written by Michael Day 12 November 1988              }
  42. {                    Copyright 1988 by Michael Day                        }
  43. {       Version 1.01 released to the public domain on 19 November 1988    }
  44. {                                                                         }
  45. {       This version (V1.03) is released to the public domain             }
  46. {                     as of 13 February 1989                              }
  47. { *********************************************************************** }
  48. { history:                                                                }
  49. { V1.01 - 19 Nov 88 - first public domain release                         }
  50. { V1.02 - 25 Nov 88 - corrected bug in special effects                    }
  51. { V1.03 - 14 Feb 89 - added RLE compression, fixed minor SE bug           }
  52.  
  53. unit SDImage;
  54. interface
  55. uses graph;
  56.  
  57. const
  58.       ImageError : word = 0;   {contains one of the possible errors below}
  59.  
  60.       NoImageError      = 0;   {Don't Worry, Be Happy! Everything's cool.}
  61.       ImageDiskError    = 1;   {Either file not found or a bum disk}
  62.       ImageBufNumTooBig = 2;   {Too big a number, See MaxImageBuf const}
  63.  
  64. {-------------------------------------------------------------------------}
  65. {Save a graphic screen Image, using Image reference number "Img" and}
  66. {working buffer "Buf". x1,y1,x2,y2 specify the screen area to save}
  67. {If something goes wrong, this function will return false.}
  68. {The lower four bits of "Style" controls the special effects.}
  69. {The upper four bits of Style controls the disk/buffer action.}
  70. {If bit 7 is on, then the image will always be forced to disk.}
  71. {If bit 7 is off, then the image will stay in the buffer if it can.}
  72. {If the image is bigger than the buffer then it is flushed to disk anyway.}
  73. {If bit 4 is on and the image is headed for the disk, then an RLE }
  74. {compression will be attempted no compression if result > non-compressed.}
  75. {Note: special effects only operate when the image is read from the disk.}
  76. {In fact it works because it uses the disk buffering as an inherent part}
  77. {of the effects control. EMS buffering is not currently implemented.}
  78. {0=Pull Down, 1=Pull Up, 2=Pull Right, 3=Pull Left, 4=Merge Vertical,}
  79. {5=Expand Vertical, 6=Merge Horizontal, 7=Expand Horizontal.}
  80.  
  81. function SaveImage(Img,Buf:word; x1,y1,x2,y2:integer; Style:word):boolean;
  82.  
  83. {-------------------------------------------------------------------------}
  84. {Displays a graphic screen image using image reference number Img and}
  85. {working buffer "Buf". If an image is residing in the buffer and is the}
  86. {correct image, then it will be displayed from the buffer. If the image}
  87. {is not the correct one, or there is no image currently saved in the}
  88. {buffer, then the buffer will be flushed to disk and the requested image}
  89. {will be read from the disk (if found) and displayed. If ImgClr is ture,}
  90. {then the image will be cleared from the buffer after being displayed.}
  91. {If the image came from disk, then the disk file will be erased as well.}
  92. {If ImgClr is false, then the image buffer and disk are left as they}
  93. {were found. If something goes wrong, this function will return false.}
  94.  
  95. function DisplayImage(Img,Buf:word; ImgClr:boolean):boolean;
  96.  
  97. {-------------------------------------------------------------------------}
  98. {The SaveImage function will automatically allocate an image buffer of the}
  99. {default size on the first use if none exists. If you wish to use a larger}
  100. {or smaller buffer, then you must use AllocImageBuf to allocate the desired}
  101. {image buffer size. If an image already exists in the buffer, it will be}
  102. {lost. Any existing old buffer space will be automatically released.}
  103. {If there is not enough heap space to allocate the buffer, this function}
  104. {will return a false condition.}
  105.  
  106. function AllocImageBuf(Buf:word; Size:word):boolean;
  107.  
  108. {-------------------------------------------------------------------------}
  109. {This releases the image buffer used with an image. You can call this to}
  110. {pick up heap space if you don't need the buffer anymore. As always,}
  111. {if the buffer is not allocated at the time SaveImage is called, then}
  112. {the default sized buffer will be allocated. Thus if you don't mind a}
  113. {slight slow down in the image process, you could call this after calling}
  114. {DisplayImage to keep heap usage to a minimum. Though keep in mind that}
  115. {if you release the buffer, any saved image in the buffer will be lost.}
  116.  
  117. function ReleaseImageBuf(Buf:word):boolean;
  118.  
  119. {-------------------------------------------------------------------------}
  120. {This sets a new path to be used for the image files. If the path does not}
  121. {exist, then it will be unchanged, and the function returns false.}
  122. {the Default path is to use the current default directory (i.e. no path).}
  123.  
  124. function SetImagePath(Path:string):boolean;
  125.  
  126. {-------------------------------------------------------------------------}
  127. {If an image is in the specified buffer, then the image will be flushed}
  128. {to disk. This can be used in preperation to releasing the buffer in order}
  129. {to gain more heap space. If the image could not be written to disk, then}
  130. {the function is aborted and returns false.}
  131.  
  132. function FlushImage(Buf:word):boolean;
  133.  
  134. {-------------------------------------------------------------------------}
  135. {An image can be deleted with this function. This will delete both images}
  136. {in the buffer and/or on disk. Retuns false if the image cannot be deleted}
  137.  
  138. function DeleteImage(Img,Buf:word):boolean;
  139.  
  140.  
  141. { *********************************************************************** }
  142.  
  143. implementation
  144.  
  145. type
  146.      string8  = string[8];
  147.      string80 = string[80];
  148.      ImgRect  = record Xmin,Ymin,Xmax,Ymax:integer; end;
  149.  
  150.      {- this gets saved to disk at the beginning of the image file -}
  151.      ImageDefRec = record     {18 bytes}
  152.        ImageNum    : word;    {image reference number in use}
  153.        MaxImgSize  : word;    {size of buffer used to write the image}
  154.        ImgArea     : ImgRect; {the overall image area definition}
  155.        ImgType     : word;    {how to save/display (special effects)}
  156.        StepSize    : word;    {how many pixel rows per segment}
  157.        StepCount   : word;    {how many image segments used}
  158.        WrkSize     : word;    {how big full image is; $ffff= over 64K}
  159.      end;
  160.  
  161.      {- this is put at the begining of packed records -}
  162.      ImagePakRec = record
  163.        PakSize  : word;       {how long this record is}
  164.        PakStart : word;       {where actual packing starts}
  165.      end;
  166.  
  167.      {- this is only used by the image buffer -}
  168.      ImageBufRec = record     {16 bytes}
  169.        MaxBufSize  : word;    {how big the image buffer is}
  170.        RawImage    : pointer; {points to image buffer on heap}
  171.        RawArea     : ImgRect; {image segment area}
  172.        RawSize     : word;    {size of image segment; 0=empty buffer}
  173.      end;
  174.  
  175. const  {variable constants}
  176.       ImgFileError : boolean  = false; {a disk error of some sort occured}
  177.       ImgPath      : string80 = '';    {Path used to get to the image files}
  178.  
  179. const  {fixed constants}
  180.       MaxImageBuf  = 20;       {maximum allowed working buffers}
  181.       MaxRawImage  = 5000;     {default image buffer size in bytes}
  182.       ImgExpCount  = 5;        {Explode increment count}
  183.       ImgName      = 'SDI';    {Image file name (five digits are added)}
  184.       ImgNameTag   = '.IMG';   {Image file name tag (extent)}
  185.       ImgFileWrite = true;     {Open an image file for writing}
  186.       ImgFileRead  = false;    {Open an image file for reading}
  187.       ImgAreaWrite = true;     {Write to the image file}
  188.       ImgAreaRead  = false;    {Read from the image file}
  189.  
  190. var   {plain old variables}
  191.      ImgBuf  : array[0..MaxImageBuf] of ImageBufRec; {buffer info}
  192.      ImgDef  : array[0..MaxImageBuf] of ImageDefRec; {disk info}
  193.      ImgFile : file;
  194.  
  195. { ----------------------------------------------------------------------- }
  196. {                                  ImgType                                }
  197. { +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }
  198. { |bit|  3  |    2    |  1   |      0      | |  7   |   6   |  5  |  4  | }
  199. { +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }
  200. { | 1 | --- | Xpd/Mrg | Horz | Xpd/Left/Dn | | Disk |  EMS  | --- | RLE | }
  201. { +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }
  202. { | 0 | --- |  Pull   | Vert | Mrg/Rght/Up | | Auto | NoEMS | --- | BIN | }
  203. { +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }
  204.  
  205. {Note: EMS is not currently implemented }
  206.  
  207. { *********************************************************************** }
  208. {                         misc support functions                          }
  209. { *********************************************************************** }
  210.  
  211. {--------------------------------------------------}
  212. {convert a word to a zero filled string}
  213. function z5str(W:word):string8;
  214. var S:string8;
  215. begin
  216.   str(W,S);
  217.   while length(S) < 5 do S := '0'+S;
  218.   z5str := S;
  219. end;
  220.  
  221. {--------------------------------------------------}
  222. {check for invalid Buf # }
  223. function ImageCheckOK(Buf:word):boolean;
  224. begin
  225.    if Buf > MaxImageBuf then
  226.    begin
  227.      ImageCheckOK := false;
  228.      ImageError := ImageBufNumTooBig;
  229.      Exit;
  230.    end;
  231.    ImageError := NoImageError;
  232.    ImageCheckOK := true;
  233. end;
  234.  
  235.  
  236. { *********************************************************************** }
  237. {                           Internal disk functions                       }
  238. { *********************************************************************** }
  239.  
  240. {$I-}
  241.  
  242. {-------------------------------------------------------------------------}
  243. {                         OpenImageFile                                   }
  244. {-------------------------------------------------------------------------}
  245. {open an image file for reading or writing }
  246. function OpenImageFile(Buf:word; ImgWrite:boolean):boolean;
  247. var RawCount:word;
  248. begin
  249.   OpenImageFile := false;
  250.   if IOResult = 0 then {nop} ;
  251.   ImgFileError := true;
  252.   Assign(ImgFile,ImgPath+ImgName+z5str(ImgDef[Buf].ImageNum)+ImgNameTag);
  253.   if ImgWrite then
  254.   begin
  255.     ImgDef[Buf].MaxImgSize := ImgBuf[Buf].MaxBufSize;
  256.     rewrite(ImgFile,1);
  257.     BlockWrite(ImgFile, ImgDef[Buf], sizeof(ImgDef[Buf]), RawCount);
  258.     if (IOResult <> 0) or (sizeof(ImgDef[Buf]) <> RawCount) then Exit;
  259.   end
  260.   else
  261.   begin
  262.     reset(ImgFile,1);
  263.     BlockRead(ImgFile, ImgDef[Buf], sizeof(ImgDef[Buf]), RawCount);
  264.     if (IOResult <> 0) or (sizeof(ImgDef[Buf]) <> RawCount) then Exit;
  265.     if ImgDef[Buf].MaxImgSize > Imgbuf[Buf].MaxBufSize then
  266.     begin
  267.       if not AllocImageBuf(Buf,ImgDef[Buf].MaxImgSize) then Exit;
  268.     end;
  269.   end;
  270.   ImgFileError := false;
  271.   OpenImageFile := true;
  272. end;
  273.  
  274. {-------------------------------------------------------------------------}
  275. {                        CloseImageFile                                   }
  276. {-------------------------------------------------------------------------}
  277. {close the image file 'cause we're done with it}
  278. function CloseImageFile:boolean;
  279. begin
  280.   CloseImageFile := false;
  281.   Close(ImgFile);
  282.   if (IOResult <> 0) then ImgFileError := true;
  283.   if ImgFileError then
  284.   begin
  285.     ImageError := ImageDiskError;
  286.     Exit;
  287.   end;
  288.   CloseImageFile := true;
  289. end;
  290.  
  291.  
  292. {-------------------------------------------------------------------------}
  293. {                                 ScanImg                                 }
  294. {-------------------------------------------------------------------------}
  295. function ScanImg(var RawImage; Size:word):word;
  296. Inline(
  297.   {;function ScanImg(var RawImage:byte; Size:word):word;}
  298.   {;this scans a buffer, and returns a pointer into the}
  299.   {;buffer for where to start packing. A value equal to}
  300.   {;the length of the buffer means that it cannot be packed.}
  301.                          {start:}
  302.   $59                    {    pop cx        ;get buffer length}
  303.   /$89/$CB               {    mov bx,cx    ;copy into bx too}
  304.   /$5E                   {    pop si        ;get image pointer}
  305.   /$89/$F7               {    mov di,si    ;put copy in di}
  306.   /$58                   {    pop ax        ;get image buffer seg}
  307.   /$1E                   {    push ds        ;save current ds}
  308.   /$55                   {    push bp        ;and bp}
  309.   /$89/$CD               {    mov bp,cx    ;copy length to bp too}
  310.   /$8E/$D8               {    mov ds,ax    ;point ds to buffer}
  311.   /$09/$C9               {    or cx,cx    ;if zero length buffer}
  312.   /$74/$54               {    jz norle    ;abort}
  313.   /$31/$D2               {    xor dx,dx    ;clear sameness counter}
  314.   /$8A/$04               {    mov al,[si]    ;get first byte}
  315.                          {scloop:}
  316.   /$88/$C4               {    mov ah,al    ;save old value}
  317.   /$42                   {    inc dx        ;inc sameness count}
  318.   /$49                   {    dec cx        ;done yet?}
  319.   /$74/$37               {    jz scdone    ;yes, so go pack it up}
  320.   /$46                   {    inc si        ;update read pointer}
  321.   /$8A/$04               {    mov al,[si]    ;get new value}
  322.   /$38/$C4               {    cmp ah,al    ;same as old value?}
  323.   /$75/$06               {    jnz ntsame    ;no, so update}
  324.   /$81/$FA/$FF/$00       {    cmp dx,255    ;if dx = 255}
  325.   /$75/$ED               {    jnz scloop    ;force update anyway}
  326.                          {ntsame:}
  327.   /$81/$FA/$03/$00       {    cmp dx,3    ;if more than 3 the same}
  328.   /$7F/$12               {    jg dorle    ;than pack it down}
  329.   /$80/$FC/$00           {    cmp ah,0    ;or if it was a 0}
  330.   /$74/$0D               {    jz dorle    ;do a pack anyway}
  331.   /$29/$D3               {    sub bx,dx    ;adjust buffer length}
  332.   /$72/$2E               {    jc norle    ;abort if no room}
  333.   /$31/$D2               {    xor dx,dx    ;clear counter}
  334.   /$39/$FE               {    cmp si,di    ;if si <> di}
  335.   /$75/$D8               {    jnz scloop    ;then continue}
  336.   /$47                   {    inc di        ;else adjust di}
  337.   /$EB/$D5               {    jmp scloop    ;and continue}
  338.                          {dorle:}
  339.   /$81/$EB/$03/$00       {    sub bx,3    ;adjust buffer length }
  340.   /$72/$1F               {    jc norle    ;abort if no room}
  341.   /$39/$D9               {    cmp cx,bx    ;if buffer pointer below}
  342.   /$7C/$04               {    jl notrlex    ;read pointer fix it up}
  343.   /$89/$F7               {    mov di,si    ;by adjusting to current}
  344.   /$89/$CB               {    mov bx,cx}
  345.                          {notrlex:}
  346.   /$31/$D2               {    xor dx,dx    ;clear counter}
  347.   /$EB/$C3               {    jmp scloop    ;loop until done}
  348.                          {scdone:}
  349.   /$29/$D3               {    sub bx,dx    ;adjust for sameness}
  350.   /$72/$0F               {    jc norle}
  351.   /$81/$EB/$03/$00       {    sub bx,3    ;need a little extra space}
  352.   /$72/$09               {    jc norle    ;to do this stuff}
  353.   /$29/$FE               {    sub si,di    ;compute pack length}
  354.   /$89/$E8               {    mov ax,bp    ;get old length}
  355.   /$29/$F0               {    sub ax,si    ;compute pack start offset }
  356.   /$E9/$02/$00           {    jmp scexit    ;return it to caller}
  357.                          {norle:}
  358.   /$89/$E8               {    mov ax,bp    ;return buffer length}
  359.                          {scexit:}
  360.   /$5D                   {    pop bp}
  361.   /$1F                   {    pop ds}
  362.                          {    end}
  363. );
  364.  
  365. {-------------------------------------------------------------------------}
  366. {                             PakImg                                      }
  367. {-------------------------------------------------------------------------}
  368. function PakImg(var RawImage; Size,Start:word):word;
  369. Inline(
  370.   {;function PakImg(var RawImage; Size,Start:word):word;}
  371.   {;this scans a buffer, and returns a pointer into the}
  372.   {;buffer for where to start packing. A value equal to}
  373.   {;the length of the buffer means that it cannot be packed.}
  374.                          {start:}
  375.   $5B                    {    pop bx        ;get paking start offset}
  376.   /$4B                   {    dec bx        ;adjust for offset}
  377.   /$59                   {    pop cx        ;get buffer length}
  378.   /$89/$C8               {    mov ax,cx    ;temp save count}
  379.   /$29/$D9               {    sub cx,bx    ;calc remainder count}
  380.   /$5E                   {    pop si        ;get image pointer}
  381.   /$01/$DE               {    add si,bx    ;add start offset to it}
  382.   /$89/$F7               {    mov di,si    ;put copy in di}
  383.   /$5A                   {    pop dx        ;get image buffer seg}
  384.   /$1E                   {    push ds        ;save current ds}
  385.   /$8E/$DA               {    mov ds,dx    ;point ds to buffer}
  386.   /$09/$C0               {    or ax,ax    ;if zero length, abort}
  387.   /$74/$52               {    jz pkexit}
  388.   /$39/$D8               {    cmp ax,bx    ;if start is at end, abort}
  389.   /$74/$4E               {    jz pkexit}
  390.   /$31/$D2               {    xor dx,dx    ;clear sameness counter}
  391.   /$8A/$04               {    mov al,[si]    ;get first byte}
  392.                          {pkloop:}
  393.   /$88/$C4               {    mov ah,al    ;save old value}
  394.   /$42                   {    inc dx        ;inc sameness count}
  395.   /$49                   {    dec cx        ;done yet?}
  396.   /$74/$33               {    jz pkdone    ;yes, so go pack it up}
  397.   /$46                   {    inc si        ;update read pointer}
  398.   /$8A/$04               {    mov al,[si]    ;get new value}
  399.   /$38/$C4               {    cmp ah,al    ;same as old value?}
  400.   /$75/$06               {    jnz pkntsm    ;no, so update}
  401.   /$81/$FA/$FF/$00       {    cmp dx,255    ;if dx = 255}
  402.   /$75/$ED               {    jnz pkloop    ;force update anyway}
  403.                          {pkntsm:}
  404.   /$81/$FA/$03/$00       {    cmp dx,3    ;if more than 3 the same}
  405.   /$7F/$0F               {    jg pkrle    ;than pack it down}
  406.   /$80/$FC/$00           {    cmp ah,0    ;or if it was a 0}
  407.   /$74/$0A               {    jz pkrle    ;do a pack anyway}
  408.   /$01/$D3               {    add bx,dx    ;add to length count}
  409.                          {ntslp:}
  410.   /$88/$25               {    mov [di],ah    ;copy bytes to buffer}
  411.   /$47                   {    inc di        ;inc copy pointer}
  412.   /$4A                   {    dec dx        ;copy until done}
  413.   /$75/$FA               {    jnz ntslp    }
  414.   /$EB/$D8               {    jmp pkloop    ;and continue}
  415.                          {pkrle:}
  416.   /$81/$C3/$03/$00       {    add bx,3    ;add to length count}
  417.   /$88/$25               {    mov [di],ah    ;save image byte}
  418.   /$47                   {    inc di}
  419.   /$88/$15               {    mov [di],dl    ;save count}
  420.   /$47                   {    inc di}
  421.   /$31/$D2               {    xor dx,dx    ;clear counter}
  422.   /$88/$35               {    mov [di],dh    ;0=packet}
  423.   /$47                   {    inc di}
  424.   /$EB/$C7               {    jmp pkloop    ;loop until done}
  425.                          {pkdone:}
  426.   /$81/$C3/$03/$00       {    add bx,3    ;add to length count}
  427.   /$88/$25               {    mov [di],ah    ;save image byte}
  428.   /$47                   {    inc di}
  429.   /$88/$15               {    mov [di],dl    ;save count}
  430.   /$47                   {    inc di}
  431.   /$31/$D2               {    xor dx,dx    ;clear counter}
  432.   /$88/$35               {    mov [di],dh    ;0=packet}
  433.   /$47                   {    inc di}
  434.   /$89/$D8               {    mov ax,bx    ;return count in ax}
  435.                          {pkexit:}
  436.   /$1F                   {    pop ds        ;restore old ds}
  437.                          {    end}
  438. );
  439.  
  440.  
  441. {-------------------------------------------------------------------------}
  442. {                               UnPakImage                                }
  443. {-------------------------------------------------------------------------}
  444. {unpacks an image inplace in the raw buffer}
  445. procedure UnPakImage(var RawImage; RawSize,PakSize,PakStart:word);
  446. Inline(
  447.   {;on entry si points to the first entry to unpack}
  448.   {;and di points to the end of the buffer. }
  449.   {;es points to the buffer segment}
  450.   {;procedure UnPakImage(var RawImage:byte; Rawsize,PakSize,PakStart:word);}
  451.                          {unrle:}
  452.   $5B                    {    pop bx        ;get PakStart}
  453.   /$5E                   {    pop si        ;get PakSize}
  454.   /$5F                   {    pop di        ;get RawSize}
  455.   /$58                   {    pop ax        ;Get RawImage offset}
  456.   /$01/$C3               {    add bx,ax    ;make stop pointer}
  457.   /$4B                   {    dec bx}
  458.   /$01/$C6               {    add si,ax    ;make read pointer}
  459.   /$4E                   {    dec si}
  460.   /$01/$C7               {    add di,ax    ;make write pointer}
  461.   /$4F                   {    dec di}
  462.   /$58                   {    pop ax        ;get RawImage segment}
  463.   /$1E                   {    push ds        ;save current ds}
  464.   /$8E/$D8               {    mov ds,ax    ;point to RawImage seg as ds}
  465.   /$8A/$24               {    mov ah,[si]    ;get a value}
  466.   /$4E                   {    dec si}
  467.   /$8A/$2C               {    mov ch,[si]    ;get a value}
  468.   /$4E                   {    dec si}
  469.                          {unpklp:}
  470.   /$39/$DF               {    cmp di,bx    ;when the pointers are }
  471.   /$7E/$27               {    jle unpkdn    ;the same (or less), we're done}
  472.   /$88/$E0               {    mov al,ah    ;0=al,1=ah,2=ch}
  473.   /$88/$EC               {    mov ah,ch}
  474.   /$8A/$2C               {    mov ch,[si]    ;get next value}
  475.   /$4E                   {    dec si}
  476.   /$08/$C0               {    or al,al    ;is it a packet?}
  477.   /$74/$05               {    jz unpkit    ;yes, so unpack it}
  478.   /$88/$05               {    mov [di],al    ;otherwise just store it}
  479.   /$4F                   {    dec di}
  480.   /$EB/$EC               {    jmp unpklp    ;and continue}
  481.                          {unpkit:}
  482.   /$88/$E1               {    mov cl,ah    ;get pack count}
  483.   /$88/$E8               {    mov al,ch    ;get image byte}
  484.   /$8A/$24               {    mov ah,[si]    ;update look ahead regs}
  485.   /$4E                   {    dec si}
  486.   /$8A/$2C               {    mov ch,[si]}
  487.   /$4E                   {    dec si}
  488.                          {unpkrl:}
  489.   /$39/$DF               {    cmp di,bx    ;when the pointers are }
  490.   /$7E/$09               {    jle unpkdn    ;the same (or less), we're done}
  491.   /$88/$05               {    mov [di],al    ;and unpack the image}
  492.   /$4F                   {    dec di        ;adjust pointer}
  493.   /$FE/$C9               {    dec cl}
  494.   /$75/$F5               {    jnz unpkrl}
  495.   /$EB/$D5               {    jmp unpklp    ;go get next one}
  496.                          {unpkdn:            ;that's it, we're done}
  497.   /$1F                   {    pop ds        ;restore old ds}
  498.                          {    end}
  499. );
  500.  
  501.  
  502. {-------------------------------------------------------------------------}
  503. {                             PackImgRW                                   }
  504. {-------------------------------------------------------------------------}
  505. {reads or writes file to/from disk using rle packing if requested}
  506. procedure PackImgRW(Buf:word; ImgWrt:boolean);
  507. var RawCount:word;
  508.     PakInfo:ImagePakRec;
  509. begin
  510.    with ImgBuf[Buf],RawArea,PakInfo do
  511.    begin
  512.      RawSize := ImageSize(Xmin,Ymin,Xmax,Ymax);
  513.      if ImgWrt then
  514.      begin
  515.        if ImgDef[Buf].ImgType and $10 = $10 then
  516.        begin
  517.          PakStart := ScanImg(RawImage^,RawSize);
  518.          PakSize := PakImg(RawImage^,RawSize,PakStart);
  519.          BlockWrite(ImgFile, PakInfo, sizeof(PakInfo), RawCount);
  520.          BlockWrite(ImgFile, RawImage^, PakSize, RawCount);
  521.          if RawCount = PakSize then RawCount := RawSize;
  522.        end
  523.        else
  524.        begin
  525.          BlockWrite(ImgFile, RawImage^, RawSize, RawCount);
  526.        end;
  527.      end
  528.      else
  529.      begin
  530.        if ImgDef[Buf].ImgType and $10 = $10 then
  531.        begin
  532.          BlockRead(ImgFile, PakInfo, sizeof(PakInfo), RawCount);
  533.          BlockRead(ImgFile, RawImage^, PakSize, RawCount);
  534.          UnPakImage(RawImage^,RawSize,PakSize,PakStart);
  535.          if RawCount = PakSize then RawCount := RawSize;
  536.        end
  537.        else
  538.        begin
  539.          BlockRead(ImgFile, RawImage^, RawSize, RawCount);
  540.        end;
  541.      end;
  542.      if RawCount <> RawSize then ImgFileError := true;
  543.    end;
  544. end;
  545.  
  546. {-------------------------------------------------------------------------}
  547. {                        RWrawImage                                       }
  548. {-------------------------------------------------------------------------}
  549. {read/write the image segment from/to disk }
  550. procedure RWrawImage(Buf:word; ImgWrt:boolean);
  551. var RawCount:word;
  552. begin
  553.    with ImgBuf[Buf],RawArea do
  554.    begin
  555.      if ImgWrt then
  556.      begin
  557.        GetImage(Xmin,Ymin,Xmax,Ymax,RawImage^);
  558.        PackImgRW(Buf,ImgWrt);
  559.      end
  560.      else
  561.      begin
  562.        PackImgRW(Buf,ImgWrt);
  563.        if not ImgFileError then
  564.          PutImage(Xmin,Ymin,RawImage^,NormalPut);
  565.      end;
  566.      RawSize := 0;
  567.    end;
  568. end;
  569.  
  570. {-------------------------------------------------------------------------}
  571. {                        RWImageArea                                      }
  572. {-------------------------------------------------------------------------}
  573. procedure RWImageArea(Buf:byte; ImgWrt:boolean);
  574. var Area1,Area2:ImgRect;
  575. begin
  576.    with ImgBuf[Buf],ImgDef[Buf],RawArea do
  577.    begin
  578.      RawArea := ImgArea;
  579.      if WrkSize <= MaxBufSize then
  580.      begin
  581.        RWrawImage(Buf,ImgWrt);
  582.        Exit;
  583.      end;
  584.  
  585.      case (ImgType and $07) of
  586.  
  587.        $00 :  {Pull Down (Vertical)}
  588.        begin
  589.          Ymax := Ymin + pred(StepSize);
  590.          while Ymax < ImgArea.Ymax do
  591.          begin
  592.            RWrawImage(Buf,ImgWrt);
  593.            Ymin := Ymin + StepSize;
  594.            Ymax := Ymax + StepSize;
  595.          end;
  596.          Ymax := ImgArea.Ymax;
  597.          RWrawImage(Buf,ImgWrt);
  598.        end;
  599.  
  600.        $01 :  {Pull Up (Vertical)}
  601.        begin
  602.          Ymin := Ymax - pred(StepSize);
  603.          while Ymin > ImgArea.Ymin do
  604.          begin
  605.            RWrawImage(Buf,ImgWrt);
  606.            Ymin := Ymin - StepSize;
  607.            Ymax := Ymax - StepSize;
  608.          end;
  609.          Ymin := ImgArea.Ymin;
  610.          RWrawImage(Buf,ImgWrt);
  611.        end;
  612.  
  613.        $02 :  {Pull Right (Horizontal)}
  614.        begin
  615.          Xmax := Xmin + pred(StepSize);
  616.          while Xmax < ImgArea.Xmax do
  617.          begin
  618.            RWrawImage(Buf,ImgWrt);
  619.            Xmin := Xmin + StepSize;
  620.            Xmax := Xmax + StepSize;
  621.          end;
  622.          Xmax := ImgArea.Xmax;
  623.          RWrawImage(Buf,ImgWrt);
  624.        end;
  625.  
  626.        $03 :  {Pull Left (Horizontal)}
  627.        begin
  628.          Xmin := Xmax - pred(StepSize);
  629.          while Xmin > ImgArea.Xmin do
  630.          begin
  631.            RWrawImage(Buf,ImgWrt);
  632.            Xmin := Xmin - StepSize;
  633.            Xmax := Xmax - StepSize;
  634.          end;
  635.          Xmin := ImgArea.Xmin;
  636.          RWrawImage(Buf,ImgWrt);
  637.        end;
  638.  
  639.        $04 :  {Mrg Vertical}
  640.        begin
  641.          begin
  642.            Area1 := ImgArea;
  643.            Area2 := ImgArea;
  644.            Area1.Ymax := Area1.Ymin + pred(StepSize);
  645.            Area2.Ymin := Area2.Ymax - pred(StepSize);
  646.            while Area1.Ymax < Area2.Ymin do
  647.            begin
  648.              RawArea := Area1;
  649.              RWrawImage(Buf,ImgWrt);
  650.              Area1.Ymin := Area1.Ymin + StepSize;
  651.              Area1.Ymax := Area1.Ymax + StepSize;
  652.              RawArea := Area2;
  653.              RWrawImage(Buf,ImgWrt);
  654.              Area2.Ymin := Area2.Ymin - StepSize;
  655.              Area2.Ymax := Area2.Ymax - StepSize;
  656.            end;
  657.            RawArea := Area1;
  658.            while RawArea.Ymax < Area2.Ymax do
  659.            begin
  660.              RWrawImage(Buf,ImgWrt);
  661.              Ymin := Ymin + StepSize;
  662.              Ymax := Ymax + StepSize;
  663.            end;
  664.            if RawArea.Ymin <= Area2.Ymax then
  665.            begin
  666.              Ymax := Area2.Ymax;
  667.              RWrawImage(Buf,ImgWrt);
  668.            end;
  669.          end;
  670.        end;
  671.  
  672.        $05 :  {Xpd Vertical}
  673.        begin
  674.          begin
  675.            Area1 := ImgArea;
  676.            Area2 := ImgArea;
  677.            Area1.Ymax := ImgArea.Ymin+((ImgArea.Ymax-ImgArea.Ymin)shr 1);
  678.            Area1.Ymin := Area1.Ymax - pred(StepSize);
  679.            Area2.Ymin := succ(Area1.Ymax);
  680.            Area2.Ymax := Area2.Ymin + pred(StepSize);
  681.            while (Area1.Ymin>ImgArea.Ymin) and (Area2.Ymax<ImgArea.Ymax) do
  682.            begin
  683.              if (Area1.Ymin > ImgArea.Ymin) then
  684.              begin
  685.                RawArea := Area1;
  686.                RWrawImage(Buf,ImgWrt);
  687.                Area1.Ymin := Area1.Ymin - StepSize;
  688.                Area1.Ymax := Area1.Ymax - StepSize;
  689.              end;
  690.              if (Area2.Ymax < ImgArea.Ymax) then
  691.              begin
  692.                RawArea := Area2;
  693.                RWrawImage(Buf,ImgWrt);
  694.                Area2.Ymin := Area2.Ymin + StepSize;
  695.                Area2.Ymax := Area2.Ymax + StepSize;
  696.              end;
  697.            end;
  698.            RawArea := Area1;
  699.            if (RawArea.Ymax >= ImgArea.Ymin) then
  700.            begin
  701.              RawArea.Ymin := ImgArea.Ymin;
  702.              RWrawImage(Buf,ImgWrt);
  703.            end;
  704.            RawArea := Area2;
  705.            if (RawArea.Ymin <= ImgArea.Ymax) then
  706.            begin
  707.              RawArea.Ymax := ImgArea.Ymax;
  708.              RWrawImage(Buf,ImgWrt);
  709.            end;
  710.          end;
  711.        end;
  712.  
  713.        $06 :  {Mrg Horizontal}
  714.        begin
  715.          begin
  716.            Area1 := ImgArea;
  717.            Area2 := ImgArea;
  718.            Area1.Xmax := Area1.Xmin + pred(StepSize);
  719.            Area2.Xmin := Area2.Xmax - pred(StepSize);
  720.            while Area1.Xmax < Area2.Xmin do
  721.            begin
  722.              RawArea := Area1;
  723.              RWrawImage(Buf,ImgWrt);
  724.              Area1.Xmin := Area1.Xmin + StepSize;
  725.              Area1.Xmax := Area1.Xmax + StepSize;
  726.              RawArea := Area2;
  727.              RWrawImage(Buf,ImgWrt);
  728.              Area2.Xmin := Area2.Xmin - StepSize;
  729.              Area2.Xmax := Area2.Xmax - StepSize;
  730.            end;
  731.            RawArea := Area1;
  732.            while RawArea.Xmax < Area2.Xmax do
  733.            begin
  734.              RWrawImage(Buf,ImgWrt);
  735.              Xmin := Xmin + StepSize;
  736.              Xmax := Xmax + StepSize;
  737.            end;
  738.            if RawArea.Xmin <= Area2.Xmax then
  739.            begin
  740.              Xmax := Area2.Xmax;
  741.              RWrawImage(Buf,ImgWrt);
  742.            end;
  743.          end;
  744.        end;
  745.  
  746.        $07 :  {Xpd Horizontal}
  747.        begin
  748.          begin
  749.            Area1 := ImgArea;
  750.            Area2 := ImgArea;
  751.            Area1.Xmax := ImgArea.Xmin+((ImgArea.Xmax-ImgArea.Xmin)shr 1);
  752.            Area1.Xmin := Area1.Xmax - pred(StepSize);
  753.            Area2.Xmin := succ(Area1.Xmax);
  754.            Area2.Xmax := Area2.Xmin + pred(StepSize);
  755.            while (Area1.Xmin > ImgArea.Xmin) and (Area2.Xmax < ImgArea.Xmax) do
  756.            begin
  757.              if (Area1.Xmin > ImgArea.Xmin) then
  758.              begin
  759.                RawArea := Area1;
  760.                RWrawImage(Buf,ImgWrt);
  761.                Area1.Xmin := Area1.Xmin - StepSize;
  762.                Area1.Xmax := Area1.Xmax - StepSize;
  763.              end;
  764.              if (Area2.Xmax < ImgArea.Xmax) then
  765.              begin
  766.                RawArea := Area2;
  767.                RWrawImage(Buf,ImgWrt);
  768.                Area2.Xmin := Area2.Xmin + StepSize;
  769.                Area2.Xmax := Area2.Xmax + StepSize;
  770.              end;
  771.            end;
  772.            RawArea := Area1;
  773.            if (RawArea.Xmax >= ImgArea.Xmin) then
  774.            begin
  775.              RawArea.Xmin := ImgArea.Xmin;
  776.              RWrawImage(Buf,ImgWrt);
  777.            end;
  778.            RawArea := Area2;
  779.            if (RawArea.Xmin <= ImgArea.Xmax) then
  780.            begin
  781.              RawArea.Xmax := ImgArea.Xmax;
  782.              RWrawImage(Buf,ImgWrt);
  783.            end;
  784.          end;
  785.        end;
  786.  
  787.  
  788.      end; {case}
  789.    end; {with}
  790. end;
  791.  
  792. {-------------------------------------------------------------------------}
  793. {                        WriteImage                                       }
  794. {-------------------------------------------------------------------------}
  795. {write an image to buffer/disk }
  796. function WriteImage(Buf:word):boolean;
  797. var Iss,Ssc:word;
  798. begin
  799.    WriteImage := false;
  800.    with ImgBuf[Buf],ImgDef[Buf] do
  801.    begin
  802.      with ImgArea do
  803.      begin
  804.        if ImgType and $02 = $00 then  {- $00=vertical action, $02=horizontal -}
  805.        begin
  806.          Ssc := Ymax-Ymin;                             {total image rows used}
  807.          Iss :=  ImageSize(Xmin,Ymin,Xmax,succ(Ymin)); {image row size (bytes)}
  808.        end
  809.        else                        {Ssc= total row count}
  810.        begin                       {Iss= row size in bytes}
  811.          Ssc := Xmax-Xmin;
  812.          Iss := ImageSize(Xmin,Ymin,succ(Xmin),Ymax);
  813.        end;
  814.        if MaxBufSize < Iss then                 {gotta have at least one rows}
  815.          if not AllocImageBuf(Buf,Iss) then Exit;  {worth of buffer space}
  816.        StepSize := MaxBufSize div Iss;
  817.        StepCount := Ssc div StepSize;
  818.        if Ssc mod StepSize > 0 then inc(StepCount);
  819.      end;
  820.  
  821.      if OpenImageFile(Buf,ImgFileWrite) then
  822.         RWImageArea(Buf,ImgAreaWrite);
  823.  
  824.      if not CloseImageFile then
  825.      begin
  826.        Erase(ImgFile);
  827.        RawSize := 0;
  828.        if IOResult <> 0 then {nop} ;
  829.        Exit;
  830.      end;
  831.    end;
  832.    WriteImage := true;
  833. end;
  834.  
  835.  
  836. {-------------------------------------------------------------------------}
  837. {                         ReadImage                                       }
  838. {-------------------------------------------------------------------------}
  839. {Read an image from the disk}
  840. function ReadImage(Buf:word; ImgClr:boolean):boolean;
  841. begin
  842.    ReadImage := false;
  843.    with ImgBuf[Buf],ImgDef[Buf] do
  844.    begin
  845.      if OpenImageFile(Buf,ImgFileRead) then
  846.        RWImageArea(Buf,ImgAreaRead);
  847.  
  848.      if not CloseImageFile then Exit;
  849.      if ImgClr then Erase(ImgFile);
  850.      if IOResult <> 0 then Exit;
  851.    end;
  852.    ReadImage := true;
  853. end;
  854.  
  855. {$I+}
  856.  
  857.  
  858. { *********************************************************************** }
  859. {                         External access functions                       }
  860. { *********************************************************************** }
  861.  
  862. {-------------------------------------------------------------------------}
  863. {                          AllocImageBuf                                  }
  864. {-------------------------------------------------------------------------}
  865. {This allocates a buffer for use with an image. You must call this before}
  866. {you can use an image buffer if you want it to be a different size than}
  867. {the default. If the buffer is not allocated at the time SaveImage is}
  868. {called, then the default sized buffer will be allocated.}
  869.  
  870. function AllocImageBuf(Buf:word; Size:word):boolean;
  871. begin
  872.   AllocImageBuf := false;
  873.   if not ImageCheckOK(Buf) then Exit;
  874.   with ImgBuf[Buf] do
  875.   begin
  876.     if RawImage <> nil then
  877.       freemem(RawImage,MaxBufSize);
  878.     RawSize := 0;
  879.     MaxBufSize := 0;
  880.     If MaxAvail < Size then Exit;
  881.     GetMem(RawImage,Size);
  882.     MaxBufSize := Size;
  883.     ImgDef[Buf].MaxImgSize := Size;
  884.   end;
  885.   AllocImageBuf := true;
  886. end;
  887.  
  888.  
  889. {-------------------------------------------------------------------------}
  890. {                        ReleaseImageBuf                                  }
  891. {-------------------------------------------------------------------------}
  892. {This releases the image buffer used with an image. You can call this to}
  893. {pick up heap space if you don't need the buffer anymore. As always,}
  894. {if the buffer is not allocated at the time SaveImage is called, then}
  895. {the default sized buffer will be allocated. Thus if you don't mind a}
  896. {slight slow down in the image process, you could call this after calling}
  897. {DisplayImage to keep heap usage to a minimum.}
  898.  
  899. function ReleaseImageBuf(Buf:word):boolean;
  900. begin
  901.   ReleaseImageBuf := false;
  902.   if not ImageCheckOK(Buf) then Exit;
  903.   with ImgBuf[Buf] do
  904.   begin
  905.     if RawImage <> nil then
  906.       freemem(RawImage,MaxBufSize);
  907.     RawImage := nil;
  908.     RawSize := 0;
  909.     MaxBufSize := 0;
  910.   end;
  911.   ReleaseImageBuf := true;
  912. end;
  913.  
  914.  
  915. {-------------------------------------------------------------------------}
  916. {                          SetImagePath                                   }
  917. {-------------------------------------------------------------------------}
  918. {This sets a new path to be used for the image files. If the path does not}
  919. {exist, then it will be created. If an error occurs the function returns }
  920. {a false condition. The Default path is to use the current default directory}
  921. {(i.e. no path).}
  922.  
  923. {$I-}
  924.  
  925. function SetImagePath(Path:string):boolean;
  926. var TPath:string;
  927. begin
  928.   SetImagePath := false;
  929.   GetDir(0,TPath);
  930.   ChDir(Path);
  931.   if IOResult <> 0 then MkDir(Path);
  932.   ChDir(TPath);
  933.   if IOResult = 0 then ImgPath := Path+'\';
  934.   if IOResult <> 0 then Exit;
  935.   SetImagePath := true;
  936. end;
  937.  
  938. {$I+}
  939.  
  940. {-------------------------------------------------------------------------}
  941. {                          FlushImage                                     }
  942. {-------------------------------------------------------------------------}
  943. {if there is an image in the buffer, flush it to disk}
  944.  
  945. function FlushImage(Buf:word):boolean;
  946. var RawCount : word;
  947. begin
  948.   FlushImage := false;
  949.   if not ImageCheckOK(Buf) then Exit;
  950.   with ImgBuf[Buf] do
  951.   begin
  952.     if RawSize > 0 then
  953.     begin
  954.       if OpenImageFile(Buf,ImgFileWrite) then
  955.         PackImgRW(Buf,ImgFileWrite);
  956.       RawSize := 0;
  957.       if not CloseImageFile then Exit;
  958.     end;
  959.   end;
  960.   FlushImage := true;
  961. end;
  962.  
  963.  
  964. {-------------------------------------------------------------------------}
  965. {                         DeleteImage                                     }
  966. {-------------------------------------------------------------------------}
  967. {This deletes images in the buffer and on disk. Any image that might}
  968. {be in the buffer is lost. Any image disk file that exists by the given}
  969. {number will be deleted. If an error occurs during the delete, such }
  970. {as the requested image is not found, the function will return false.}
  971.  
  972. {$I-}
  973.  
  974. function DeleteImage(Img,Buf:word):boolean;
  975. var RawCount : word;
  976. begin
  977.   DeleteImage := false;
  978.   if not ImageCheckOK(Buf) then Exit;
  979.   with ImgBuf[Buf] do
  980.   begin
  981.     RawSize := 0;
  982.     if OpenImageFile(Buf,ImgFileWrite) then {nop} ;
  983.     if CloseImageFile then Erase(ImgFile);
  984.     RawSize := 0;
  985.     if ImgFileError or (IOResult <> 0) then Exit;
  986.   end;
  987.   DeleteImage := true;
  988. end;
  989.  
  990. {$I+}
  991.  
  992. {-------------------------------------------------------------------------}
  993. {                          SaveImage                                      }
  994. {-------------------------------------------------------------------------}
  995. { Saves the screen image under the box. This can be called to save the}
  996. { screen image before writing the box to the screen. Use DisplayImage to}
  997. { restore the image. The lower four bits of "Style" controls the special}
  998. { effects. The upper four bits of Style controls the disk/buffer action.}
  999. { If bit 7 is on, then the image will always be forced to disk.}
  1000. { If bit 7 is off, then the image will stay in the buffer if it can.}
  1001. { If the image is bigger than the buffer then it is flushed to disk anyway.}
  1002. { If bit 4 is on and the image is headed for the disk, then an RLE }
  1003. { compression will be attempted no compression if result > non-compressed.}
  1004. { Note: special effects only operate when the image is read from the disk.}
  1005. { In fact it works because it uses the disk buffering as an inherent part}
  1006. { of the effects control. EMS buffering is not currently implemented.}
  1007. { 0=Pull Down, 1=Pull Up, 2=Pull Right, 3=Pull Left, 4=Merge Vertical,}
  1008. { 5=Expand Vertical, 6=Merge Horizontal, 7=Expand Horizontal.}
  1009.  
  1010. function SaveImage(Img,Buf:word; x1,y1,x2,y2:integer; Style:word):boolean;
  1011. begin
  1012.    SaveImage := false;
  1013.    if not ImageCheckOK(Buf) then Exit;
  1014.    if not FlushImage(Buf) then Exit;  {flush image buffer}
  1015.    if ImgBuf[Buf].RawImage = nil then
  1016.      if not AllocImageBuf(Buf,MaxRawImage) then Exit;
  1017.  
  1018.    with ImgDef[Buf],ImgArea do
  1019.    begin
  1020.      ImageNum := Img;
  1021.      ImgType := Style;
  1022.      Xmin := x1;
  1023.      Ymin := y1;
  1024.      Xmax := x2;
  1025.      Ymax := y2;
  1026.      ImgBuf[Buf].RawArea := ImgArea;
  1027.      StepSize := Ymax-Ymin;
  1028.      StepCount := 1;
  1029.      WrkSize := ImageSize(Xmin,Ymin,Xmax,Ymax);
  1030.      if WrkSize = 0 then WrkSize := $ffff;
  1031.  
  1032.      if (ImgType and $80 = 0) and (WrkSize < ImgBuf[Buf].MaxBufSize) then
  1033.      begin    {- save image to heap buffer -}
  1034.        ImgBuf[Buf].RawSize := WrkSize;
  1035.        GetImage(Xmin,Ymin,Xmax,Ymax,ImgBuf[Buf].RawImage^);
  1036.      end
  1037.      else
  1038.      begin    {- write the image to disk -}
  1039.        if not WriteImage(Buf) then Exit;
  1040.      end;
  1041.    end;
  1042.    SaveImage := true;
  1043. end;
  1044.  
  1045. {-------------------------------------------------------------------------}
  1046. {                             DisplayImage                                }
  1047. {-------------------------------------------------------------------------}
  1048. { Restores a previously saved box screen image. See SaveImage. }
  1049. { If the desired image is in the buffer, then it comes from there.}
  1050. { Otherwise the disk is searched for the desired image.}
  1051. { If ImgClr is true, then the image buffer/file will be erased after}
  1052. { the image has been displayed.}
  1053.  
  1054. function DisplayImage(Img,Buf:word; ImgClr:boolean):boolean;
  1055. begin
  1056.    DisplayImage := false;
  1057.    if not ImageCheckOK(Buf) then Exit;
  1058.  
  1059.    with ImgBuf[Buf] do
  1060.    begin
  1061.      if (Img = ImgDef[Buf].ImageNum) and (RawSize <> 0) then
  1062.      begin
  1063.        PutImage(RawArea.Xmin,RawArea.Ymin,RawImage^,NormalPut);
  1064.        if ImgClr then RawSize := 0;
  1065.      end
  1066.      else
  1067.      begin
  1068.        if not FlushImage(Buf) then Exit;  {flush image buffer if not same}
  1069.        ImgDef[Buf].ImageNum := Img;
  1070.        if not ReadImage(Buf,ImgClr) then Exit;  {read the requested image}
  1071.      end;
  1072.    end;
  1073.    DisplayImage := true;
  1074. end;
  1075.  
  1076.  
  1077. { *********************************************************************** }
  1078. { initialization }
  1079. begin
  1080.   fillchar(ImgBuf,sizeof(ImgBuf),0);
  1081.   fillchar(ImgDef,sizeof(ImgDef),0);
  1082. end.
  1083.  
  1084.